home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / pp.arc / ARGLIB.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-04-07  |  4.2 KB  |  113 lines
  1.   (* ---------------------- begin argument module -------------------------- *)
  2.  
  3.   (* ArgLib.pas  16 March 1985.              TURBO  PASCAL  version          *)
  4.  
  5.   (* Get arguments from CP/M or MS-DOS Command Line, using UNIX conventions. *)
  6.   (* Tested on Turbo Pascal ver 1 and 2; must compile to disk (not memory).  *)
  7.   (* Allows writing portable and/or UNIX-compatable programs on your micro.  *)
  8.   (* All compiler-dependencies are marked with the word "Turbo"; mods for    *)
  9.   (*   changing among CP/M-80, CP/M-86, and MS-DOS are marked in "argv".     *)
  10.  
  11.   (* CAUTION:  CP/M and MS-DOS programs must finish ALL argcount and argv    *)
  12.   (*  calls before doing ANY file operations.  (Not required under UNIX.)    *)
  13.  
  14.   (* Example:  User calls program "cp" with two files:  CP FILEA FILEB
  15.    *
  16.    *  argcount  -->   2
  17.    *  argv(1, ) --> 'FILEA           '
  18.    *  argv(2, ) --> 'FILEB           '
  19.    *)
  20.   (* EXPORT:  ArgStrType, argcount, argv, resetOK   *)
  21.  
  22.   (* author:  Willett Kempton *)
  23.  
  24. const
  25.   MaxArgStrLen = 16; (* maximum characters per argument *)
  26. type
  27.   ArgStrType = packed array[1..MaxArgStrLen]of char; (* file name argument *)
  28.  
  29.  
  30. procedure argv(    argn : integer;     (* requesting Nth argument *)
  31.                var name : ArgStrType); (* returning its char image *)
  32. (* ARGument Value.   Valid argn for files are 1..argcount.  *)
  33. (* Note: argv(0, ) incorrectly returns blank; UNIX returns program name *)
  34. const
  35.   MaxCmdLineLength = 122; (* bug: CP/M-80 Turbo v1 & v2 chops to 31 chars *)
  36. type
  37.   CmdLineType = packed array [0..MaxCmdLineLength] of char;
  38.   charset = set of char;
  39. var
  40.   i, nextch, Start, ArgLen, CmdLen : integer;
  41.   SYSdelim : charset; (* system file separators *)
  42.   CmdLine : CmdLineType
  43.       { CP/M-86 Turbo }    { absolute DSeg : $80 ; }
  44.       { MS-DOS Turbo  }      absolute CSeg : $80 ;
  45.       { CP/M-80 Turbo }    { absolute        $80 ; }
  46.  
  47. procedure skip (delims:charset);
  48. (* skip past either delimiters or arguments.  *)
  49. begin
  50.   while (CmdLine[nextch] in delims) and (nextch <= CmdLen) do
  51.     nextch := nextch + 1
  52. end (* skip *);
  53.  
  54. begin (* argv *)
  55.   CmdLen := ord(CmdLine[0]);  (* length of command line  *)
  56.   {if CmdLen > 31 then                                 }  { CP/M-80 Turbo }
  57.   {  begin writeln('Command line too long.'); Halt end;}  { CP/M-80 Turbo }
  58.   SYSdelim :=
  59. { CP/M   }   [' ',',',';','[',']','=','<','>' ,'/','_' ];
  60. { MS-DOS } { [' ',',',';','[',']','=','<','>'  ]; } (* more?? *)
  61.   nextch := 1;
  62.   Start := 1;
  63.   for i := 1 to argn do
  64.     begin
  65.       skip(SYSdelim)    (* skip leading delimiters *);
  66.       Start := nextch   (* overwriting all but last value *);
  67.       skip([chr(0)..chr(127)]-SYSdelim) (* skip argument *);
  68.       { Turbo bug prohibits [chr(0)..chr(255)]; thus 8-bit chars disallowed }
  69.     end;
  70.   ArgLen := nextch-Start;
  71.   (* now use Start and ArgLen to set the string *)
  72.   if ArgLen > MaxArgStrLen then ArgLen := MaxArgStrLen;
  73.   for i:= 1 to ArgLen do name[i] := CmdLine[Start-1+i];
  74.   for i:= (ArgLen+1) to MaxArgStrLen do name[i] := ' '; (* blank fill *)
  75. end (* argv *);
  76.  
  77.  
  78.   function argcount : integer;
  79.     (* ARGument COUNT:  Number of arguments on command line  *)
  80.     (* This is slow, so call it just once and set an integer variable. *)
  81.   var
  82.     c: integer;
  83.     ArgStr: ArgStrType;
  84.    begin
  85.      c := 0;
  86.      repeat
  87.        c := c+1;
  88.        argv(c, ArgStr);
  89.      until (ArgStr[1] = ' ');
  90.      argcount := c - 1;
  91.    end (* argcount *);
  92.  
  93.   function argc : integer;
  94.     (* Count of all arguments, including program name.  Preferred call is
  95.       "argcount"; this is retained for compatability with earlier version. *)
  96.   begin
  97.     argc := argcount + 1;
  98.   end;
  99.  
  100.  
  101.   function resetOK (var f: text; name: ArgStrType) : boolean;
  102.     (* Associate name with file variable.  Return true if file exists and
  103.       is nonempty. *)
  104.    begin
  105.      assign(f,name);   { Turbo, non-standard }
  106.     {$I-  Turbo: turn off I/O checks, or reset and eof() can cause crash. }
  107.      reset(f);
  108.      resetOK := (IOresult = 0);   { Turbo, non-standard }
  109.     {$I+  Turbo: restore I/O checks }
  110.    end (* resetOK *);
  111.  
  112.   (* ------------------------ end argument module ------------------------- *)
  113.